MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 06 - 1990/06.11 Nov 90/Kelly Source/HunkMain.p

Text File | 1990-09-03 | 15.2 KB | 671 lines | [TEXT/PJMM]

program HunkManagerDemo;

{This demo program requires}
{the Hunk Manager, available from:}
{The Gettys Group, Inc.}
{401 East Illinois Street, Suite 600}
{Chicago, Illinois 60611}
{312-836-4222}

{Demo program by Dave Kelly}
{©1990 MacTutor}

    uses
        Hunks;

    const
        appleID = 128;
        fileID = 129;
        editID = 130;
        HunkID = 131;

        appleMenu = 1;
        fileMenu = 2;
        editMenu = 3;
        HunkMenu = 4;
        menuCount = 4;
        windowID = 128;
        GetNewHunkitem = 1;
        GetHunkitem = 2;
        CloseHunkitem = 3;
        ListHunkitem = 1;
        SortHunkitem = 2;
        Quititem = 5;
        undoitem = 1;
        cutitem = 3;
        copyitem = 4;
        pasteitem = 5;
        clearitem = 6;
        isShared = false;

    var
        myMenus: array[1..menuCount] of MenuHandle;
        ignore: integer;
        dragRect: Rect;
        theChar: CHAR;
        extended: BOOLEAN;
        doneFlag: BOOLEAN;
        myEvent: EventRecord;
        wRecord: WindowRecord;
        myWindow: Windowptr;
        whichWindow: Windowptr;
        windowsize: longint;
        height, width: integer;
        sizeRect, size: Rect;
        Result: OSErr;
        hasWNE: boolean;
        cursorRgn: RgnHandle;    {for WaitNextEvent}
        Hunkfilename: string[63];
        HunkvRefNum, numHandles: integer;
        fileRef: HFilePtr;    {Hunk file pointer}
        checkTime, timeOut: longint;
        MyHunkString, MySortedstring: array[1..10] of str255;
        theType: HunkType;
        theID: longint;

    procedure swap (var a: str255; var b: str255);
        var
            temp: str255;
    begin
        temp := a;
        a := b;
        b := temp;
    end;

    procedure sortarray;
        var
            i, j: integer;
    begin
        for i := 1 to 10 do
            MySortedstring[i] := MyHunkString[i];
        for i := 1 to 9 do
            begin
                for j := i + 1 to 10 do
                    if MySortedstring[i] > MySortedString[j] then
                        swap(MySortedstring[i], MySortedstring[j]);
            end;
    end;

    procedure GetPredefinedHunks;
        var
            i: integer;
            myhandle: handle;
            theString: str255;
    begin
        for i := 1 to 10 do
            begin
                MyHunkString[i] := '';
                theID := i + 1000;
                MyHandle := (GetHunk(fileRef, 'STR#', theID));
                Result := HunkError(FileRef);
                MyHunkString[i] := stringhandle(myhandle)^^;
            end;
    end;

    procedure GetSortedHunks;
        var
            i: integer;
            myhandle: handle;
    begin
        for i := 1 to 10 do
            begin
                MySortedString[i] := '';
                theID := i + 1000;
                MyHandle := GetHunk(fileRef, 'SORT', theID);
                MySortedString[i] := stringhandle(myhandle)^^;
            end;
    end;

    procedure addsortedHunks;
        var
            i: integer;
            MyHandle: handle;
    begin
        for i := 1 to 10 do
            begin
                MyHandle := Handle(NewString(MySortedString[i]));
                theID := i + 1000;
                AddHunk(fileRef, MyHandle, 'SORT', theID);
                WriteHunk(fileRef, MyHandle);
                disableitem(myMenus[HunkMenu], 2);
            end;
    end;

    procedure showHunk;
        var
            HunkCount, Hunksize, NumberofHunks, theindex: longint;
            vertspacing, i: integer;

    begin
        eraserect(sizerect);    {clear the screen}
        hunkCount := CountHunkTypes(fileRef);
        vertspacing := 50;
        moveto(10, vertspacing);
        writeDraw('There are ', hunkCount, ' hunk type(s) in the file: ', hunkfilename);
        vertspacing := vertspacing + 12;
        moveto(10, vertspacing);
        writeDraw('The Hunk Type(s) are: ');
        for theindex := 1 to hunkcount do
            begin
                vertspacing := vertspacing + 12;
                moveto(10, vertspacing);
                GetIndHunkType(fileRef, theType, theIndex);
                Hunksize := GetHunkTypeSize(fileRef, theType);
                NumberofHunks := countHunks(fileRef, theType);
                writeDraw(theType, ',  ', hunksize, ' bytes in ', NumberofHunks, ' Hunks.');
                if theType = 'STR#' then
                    begin
                        vertspacing := vertspacing + 12;
                        moveto(10, vertspacing);
                        GetPredefinedHunks;
                        for i := 1 to 10 do
                            writedraw(MyHunkString[i], ' ');
                    end;
                if theType = 'SORT' then
                    begin
                        vertspacing := vertspacing + 12;
                        moveto(10, vertspacing);
                        GetSortedHunks;
                        for i := 1 to 10 do
                            writedraw(MySortedString[i], ' ');
                    end;
            end;
        if MySortedString[1] = '' then
            enableitem(myMenus[HunkMenu], 2);
    end;

    procedure AddPredefinedHunks;
        var
            i: integer;
            myhandle: handle;
    begin
        MyHunkString[1] := 'Memory';
        MyHunkString[2] := 'Scanner';
        MyHunkString[3] := 'Modem';
        MyHunkString[4] := 'Floppy Disk';
        MyHunkString[5] := 'Monitor';
        MyHunkString[6] := 'Keyboard';
        MyHunkString[7] := 'Mouse';
        MyHunkString[8] := 'Printer';
        MyHunkString[9] := 'Macintosh';
        MyHunkString[10] := 'Hard Disk';
        for i := 1 to 10 do
            begin
                MyHandle := Handle(NewString(MyHunkString[i]));
                theID := i + 1000;
                AddHunk(fileRef, MyHandle, 'STR#', theID);
                WriteHunk(fileRef, MyHandle);
            end;

    end;

    procedure GetNewFilename;
{Get a new filename and then create a new Hunk file}

        var
            prompt, origName: str255;
            where: point;
            reply: SFReply;
            i: integer;

        const
            HunkCreator = 'BHun';
            HunkfileType = 'HTxt';

    begin
        where.h := 50;
        where.v := 50;
        prompt := 'Enter New Data Filename:';
        origName := '';
        SFPutFile(where, prompt, origName, nil, reply);
        HunkFileName := reply.fName;
        HunkvRefNum := reply.vRefNum;
        moveto(10, 50);
        if Reply.good then
            begin
                Result := CreateHunkFile(HunkfileName, HunkvRefNum, Hunkcreator, HunkfileType);
                if Result <> 0 then
                    begin  {error occurred}
                        if result = -48 then
                            begin  {error was -48}
                                Result := FSDelete(HunkFileName, HunkvRefNum);
                                if Result = 0 then  {file was deleted}
                                    begin
                                        Result := CreateHunkFile(HunkfileName, HunkvRefNum, Hunkcreator, HunkfileType);
                                        if result <> 0 then
                                            begin
                                                moveto(10, 50);
                                                writedraw('Error= ', result, ' occurred.');
                                                exit(GetNewFileName);
                                            end;
                                        fileRef := OpenHunkFile(HunkfileName, HunkvRefNum, numHandles, checkTime, timeOut, isShared);
                                        AddPredefinedHunks;
                                    end
                                else  {there is an error deleting the file}
                                    begin
                                        moveto(10, 50);
                                        writedraw('Error= ', result, ' occurred.');
                                        exit(GetNewFileName);
                                    end;
                            end;  {error was -48}
                    end {error occurred}
                else {no error occurred}
                    begin
                        fileRef := OpenHunkFile(HunkfileName, HunkvRefNum, numHandles, checkTime, timeOut, isShared);
                        AddPredefinedHunks;
                    end;
            end;
        for i := 1 to 10 do
            MySortedString[i] := '';
    end;

    procedure GetFilename;
{Get an existing Hunk file and open it}

        var
            prompt: str255;
            where: point;
            reply: SFReply;
            typeList: SFTypeList;
            numTypes: integer;


        const
            HunkCreator = 'BHun';
            HunkfileType = 'HTxt';

    begin
        where.h := 50;
        where.v := 50;
        numTypes := 1;
        TypeList[0] := 'HTxt';
        prompt := 'Select Data Filename:';
        SFGetFile(where, prompt, nil, numTypes, typeList, nil, reply);
        HunkFileName := reply.fName;
        HunkvRefNum := reply.vRefNum;
        fileRef := OpenHunkFile(HunkfileName, HunkvRefNum, numHandles, checkTime, timeOut, isShared);
        result := hunkerror(fileref);
        if result <> 0 then
            begin
                moveto(10, 50);
                writedraw('Error= ', result, ' occurred.');
                exit(GetFileName);
            end;
        GetPredefinedHunks;
        if counthunktypes(fileref) = 2 then
            GetSortedHunks;
    end;

    procedure Closefile;
    begin
        if fileRef <> nil then
            closeHunkFile(fileRef);
    end;

    function TrapAvailable (tNumber: INTEGER; tType: TrapType): BOOLEAN;

{To check if WaitNextEvent Trap is available; the following 2 functions are found in TN#158 }

        const
            UnimplementedTrapNumber = $A89F;  {number of "unimplemented trap"}

    begin {TrapAvailable}

    {Check and see if the trap exists.}
    {On 64K ROM machines, tType will be ignored.}

        TrapAvailable := (NGetTrapAddress(tNumber, tType) <> GetTrapAddress(UnimplementedTrapNumber));

    end;  {TrapAvailable}

    function WNEIsImplemented: BOOLEAN;

        const
            WNETrapNumber = $A860; {trap number of WaitNextEvent}

        var
            theWorld: SysEnvRec; {to check if machine has new traps}
            discardError: OSErr; {to ignore OSErr return from SysEnvirons}

    begin {WNEIsImplemented}

{  Since WaitNextEvent and HFSDispatch both have the same trap }
{ number ( $60 ) , we can only call TrapAvailable }
{ for WaitNextEvent if we are on a machine that supports separate }
{ OS and Toolbox trap tables . We call SysEnvirons and check }
{ if machineType < 0. }

        discardError := SysEnvirons(1, theWorld);

{  Even if we got an error from SysEnvirons, the SysEnvirons glue }
{ has set up machineType . }

        if theWorld.machineType < 0 then
            WNEIsImplemented := FALSE
          {this ROM doesn't have separate trap tables or WaitNextEvent}
        else
            WNEIsImplemented := TrapAvailable(WNETrapNumber, ToolTrap);
          {check for WaitNextEvent}

    end;  {WNEIsImplemented}

    procedure initialize_managers;

        var
            versRequested: integer;
            theWorld: SysEnvRec;

    begin
        InitGraf(@thePort);
        InitFonts;
        InitWindows;
        InitMenus;
        TEInit;
        InitDialogs(nil);
        InitCursor;
        FlushEvents(everyEvent, 0);

        Result := SysEnvirons(versRequested, theWorld); { Refer to TN#129 for use of the SysEnvirons Function }
        if theWorld.machineType < 0 then
            begin
                hasWNE := false;
            end
        else
            begin
                hasWNE := WNEIsImplemented;
            end;
    end;

    procedure SetUpMenus;
        var
            i: integer;
    begin
        myMenus[appleMenu] := GetMenu(AppleID);
        AddResMenu(myMenus[appleMenu], 'DRVR');
        myMenus[fileMenu] := GetMenu(fileID);
        myMenus[editMenu] := GetMenu(editID);
        myMenus[HunkMenu] := GetMenu(HunkID);
        for i := 1 to menuCount do
            InsertMenu(myMenus[i], 0);
        DrawMenuBar;
        disableitem(myMenus[HunkMenu], 1);
        disableitem(myMenus[fileMenu], 3);
        disableitem(myMenus[HunkMenu], 2);
    end;

    procedure DoCommand (mResult: LONGINT);
        var
            theItem: integer;
            theMenu: integer;
            editmenu: menuhandle;
            name: Str255;
            temp: integer;
        const
            AboutID = 128;
            AboutItem = 1;

    begin
        theItem := LoWord(mResult);
        theMenu := HiWord(mResult);
        case theMenu of
            appleID:
                begin
                    case theItem of
                        Aboutitem:
                            ignore := Alert(AboutID, nil);
                        otherwise
                            begin
                                if FrontWindow = nil then
                                    begin
                                        EnableItem(EditMenu, UndoItem);
                                        EnableItem(EditMenu, CutItem);
                                        EnableItem(EditMenu, CopyItem);
                                        EnableItem(EditMenu, Pasteitem);
                                        EnableItem(EditMenu, ClearItem);
                                    end;
                                GetItem(myMenus[appleMenu], theItem, name);
                                temp := OpenDeskAcc(name);
                                SetPort(myWindow);
                            end;
                    end; { case }
                end;
            fileID:
                case theItem of
                    GetNewHunkitem:
                        begin
                            GetNewFilename;
                            if (fileRef <> nil) and (Result = 0) then
                                begin
                                    disableitem(myMenus[fileMenu], 1);
                                    disableitem(myMenus[fileMenu], 2);
                                    enableitem(myMenus[fileMenu], 3);
                                    enableitem(myMenus[HunkMenu], 1);
                                    eraserect(sizerect);    {clear the screen}
                                end;
                        end;
                    GetHunkitem:
                        begin
                            GetFilename;
                            if (fileRef <> nil) and (Result = 0) then
                                begin
                                    disableitem(myMenus[fileMenu], 1);
                                    disableitem(myMenus[fileMenu], 2);
                                    enableitem(myMenus[fileMenu], 3);
                                    enableitem(myMenus[HunkMenu], 1);
                                    eraserect(sizerect);    {clear the screen}
                                end;
                        end;
                    closeHunkitem:
                        begin
                            closefile;
                            enableitem(myMenus[fileMenu], 1);
                            enableitem(myMenus[fileMenu], 2);
                            disableitem(myMenus[fileMenu], 3);
                            disableitem(myMenus[HunkMenu], 1);
                            eraserect(sizerect);    {clear the screen}
                        end;
                    Quititem:
                        begin
                            closefile;
                            doneFlag := TRUE;
                        end;
                end;
            editID:
                begin
                    if not SystemEdit(theItem - 1) then
                        case theItem of
                            cutitem:
                                ;
                            copyitem:
                                ;
                            pasteitem:
                                ;
                            clearitem:
                                ;
                            otherwise
                                ;
                        end; { Case }
                end; { editID }
            HunkID:
                begin
                    case theItem of
                        ListHunkitem:
                            showhunk;
                        SortHunkitem:
                            begin
                                sortarray;
                                addsortedHunks;
                                showhunk;
                            end;
                        otherwise
                            ;
                    end;
                end;{ HunkID }
            otherwise
                ;
        end; { menuCase }
        HiliteMenu(0);
    end;

    procedure DoEvent (Event: EventRecord);
    begin
        case myEvent.what of
            mouseDown:
                case FindWindow(myEvent.where, whichWindow) of
                    inDesk:
                        ;
                    inMenuBar:
                        DoCommand(MenuSelect(myEvent.where));
                    inSysWindow:
                        SystemClick(myEvent, whichWindow);
                    inContent:
                        begin
                            if whichWindow <> FrontWindow then
                                SelectWindow(whichWindow)
                            else
                                begin
                                    GlobalToLocal(myEvent.where);
                                    extended := BitAnd(myEvent.modifiers, shiftKey) <> 0;
                                end;
                        end;
                    inDrag:
                        DragWindow(whichWindow, myEvent.where, dragRect);
                    inGrow:
                        begin
                            windowsize := GrowWindow(whichWindow, myEvent.where, sizeRect);
                            height := Hiword(windowsize);
                            width := LoWord(windowsize);
                            SizeWindow(whichWindow, width, height, TRUE);
                            setrect(size, 0, 0, width - 15, height);
                            invalRect(size);
                            setrect(size, 0, 0, width, height - 15);
                            invalRect(size);
                            EraseRect(thePort^.portRect);
                            DrawGrowIcon(whichWindow);
                        end;
                    inGoAway:
                        if TrackGoAway(whichWindow, myEvent.where) then
                            begin
                                CloseWindow(whichWindow);
                                closefile;
                                doneFlag := TRUE;
                            end;
                end;
            mouseUp:
                begin
                end;
            keydown, autokey:
                begin
                    theChar := CHR(BitAnd(myEvent.message, charCodeMask));
                    if BitAnd(myEvent.modifiers, cmdKey) <> 0 then
                        DoCommand(MenuKey(theChar))
                    else
                        ;
                end;
            keyUp:
                begin
                end;
            updateEvt:
                begin
                    BeginUpdate(WindowPtr(myEvent.message));
{    EraseRect(thePort^.portRect);}
                    EndUpdate(WindowPtr(myEvent.message));
                    DrawGrowIcon(WindowPtr(myEvent.message));
                end;
            diskEvt:
                begin
                end;
            activateEvt:
                begin
                    if BitAnd(myEvent.modifiers, activeFlag) <> 0 then
                        begin
                            ;
                            DisableItem(myMenus[editMenu], undoitem);
                        end
                    else
                        begin
                            ;
                            EnableItem(myMenus[editMenu], undoitem);
                        end;
                end;
            networkEvt:
                begin
                end;
            driverEvt:
                begin
                end;
            app1Evt:
                begin
                end;
            app2Evt:
                begin
                end;
            app3Evt:
                begin
                end;
            otherwise
                begin
                end;
        end;
    end;

    function GetSleep: longint;
        var
            Sleep: longint;
    begin
        Sleep := 10;  {a sleep algorithm can be inserted here}
        GetSleep := Sleep;
    end;

    function GetEvent: boolean;
        var
            theEvent: boolean;
    begin
        if hasWNE then
            begin
                theEvent := WaitNextEvent(everyEvent, MyEvent, GetSleep, cursorRgn);
            end
        else
            begin
                SystemTask;
                theEvent := GetNextEvent(everyEvent, MyEvent);
            end;
        GetEvent := theEvent;
    end; {GetEvent}
    procedure DoIdle;
    begin
{Don't do anything}
    end;

    procedure EventLoop;  {from IM vol 6}
        var
            gotEvent: boolean;
    begin
        cursorRgn := NewRgn; {pass an empty region the first time thru}
        repeat
            gotEvent := GetEvent;
{    AdjustCursor(event.where, cursorRgn);   for future use}
            if gotEvent then
                DoEvent(Myevent)
            else
                DoIdle;
        until doneFlag {loop forever}
    end;

begin
    Initialize_Managers;
    SetUpMenus;
    with screenBits.bounds do
        SetRect(dragRect, 4, 24, right - 4, bottom - 4);
    sizeRect := dragRect;
    doneFlag := FALSE;
    fileRef := nil;        {Hunk file pointer}
    checktime := 1;     {used for shared Hunk files}
    timeout := 1;         {used for shared Hunk files}
    numhandles := 2;    {minimum number of Hunk Handles is 44}
    myWindow := GetNewwindow(windowID, @wRecord, POINTER(-1));
    SetPort(myWindow);
    textfont(Geneva);
    textsize(10);
    EventLoop;
end.